home *** CD-ROM | disk | FTP | other *** search
/ Aminet 1 (Walnut Creek) / Aminet - June 1993 [Walnut Creek].iso / aminet / util / gnu / emacs_src_18_58.lha / emacs-18.58 / src / amiga_screen.c < prev    next >
C/C++ Source or Header  |  1992-09-19  |  30KB  |  1,097 lines
  1. #include "config.h"
  2. #undef NULL
  3. #include "lisp.h"
  4. #include "termchar.h"
  5. #include "dispextern.h"
  6.  
  7. #include <stdio.h>
  8. #include <string.h>
  9. #include <stddef.h>
  10. #include <internal/devices.h>
  11. #include <internal/vars.h>
  12.  
  13. #define min(x,y) ((x) > (y) ? (y) : (x))
  14. #define max(x,y) ((x) < (y) ? (y) : (x))
  15.  
  16. #undef LONGBITS
  17.  
  18. #include <exec/types.h>
  19. #include <exec/interrupts.h>
  20. #include <devices/input.h>
  21. #include <devices/inputevent.h>
  22. #include <intuition/intuitionbase.h>
  23. #include <intuition/intuition.h>
  24. #include <devices/conunit.h>
  25. #include <devices/inputevent.h>
  26. #include <graphics/gfxbase.h>
  27. #include <graphics/gfxmacros.h>
  28. #include <utility/hooks.h>
  29. #include <workbench/startup.h>
  30. #include <workbench/workbench.h>
  31.  
  32. #include <proto/exec.h>
  33. #include <proto/dos.h>
  34. #include <proto/intuition.h>
  35. #include <proto/graphics.h>
  36. #include <proto/console.h>
  37. #include <proto/diskfont.h>
  38. #include <proto/wb.h>
  39.  
  40. extern struct Library *WorkbenchBase;
  41.  
  42. #include "amiga.h"
  43.  
  44. #define SHIFT_MASK (IEQUALIFIER_LSHIFT | IEQUALIFIER_RSHIFT)
  45. #define CONTROL_MASK IEQUALIFIER_CONTROL
  46. #define META_MASK IEQUALIFIER_LALT
  47.  
  48. extern struct GfxBase *GfxBase;
  49. extern struct IntuitionBase *IntuitionBase;
  50. struct Library *DiskfontBase, *KeymapBase;
  51.  
  52. static char intkey_code, intkey_qualifier;
  53. static struct IOStdReq *input_req;
  54. static struct Interrupt int_handler_hook;
  55. static int hooked;
  56. static struct MsgPort *wbport;
  57. static struct AppWindow *emacs_app_win;
  58. static struct AppIcon *emacs_icon;
  59. static struct Device *ConsoleDevice;
  60. struct Window *emacs_win;
  61. static char *emacs_screen_name;
  62. static struct TextFont *font;
  63. static int font_opened;
  64. /* The reset string resets the console, turns off scrolling and sets up
  65.    the foreground & background colors. */
  66. #define CONSOLE_RESET "\x1b""c\x9b>1l\x9b""3%d;4%d;>%dm"
  67. static char reset_string[20]; /* Must be big enough for
  68.               printf(CONSOLE_RESET, foreground, background, background);
  69.               (0 <= foreground, background <= 7) */
  70. int foreground = 1, background = 0;
  71. WORD emacs_x, emacs_y, emacs_w, emacs_h;
  72.  
  73. static struct IOStdReq *emacs_console;
  74.  
  75. static struct NewWindow far emacs_window =
  76. {
  77.   0, 0,                /* LeftEdge, TopEdge   */
  78.   640, 200,            /* Width, Height       */
  79.   -1, -1,            /* DetailPen, BlockPen */
  80.   IDCMP_CLOSEWINDOW | IDCMP_RAWKEY | IDCMP_MOUSEBUTTONS | IDCMP_NEWSIZE |
  81.   IDCMP_MENUPICK | IDCMP_MENUHELP,
  82.   WFLG_CLOSEGADGET | WFLG_SIZEGADGET | WFLG_DRAGBAR | WFLG_DEPTHGADGET |
  83.   WFLG_ACTIVATE | WFLG_SIMPLE_REFRESH,
  84.   0,                /* First Gadget        */
  85.   0,                /* CheckMark           */
  86.   (UBYTE *)"GNU Emacs 18.58, Amiga port "VERS,
  87.   0,                /* Screen              */
  88.   0,                /* BitMap              */
  89.   0, 0,                /* Min Width, Height   */
  90.   STDSCREENWIDTH, STDSCREENHEIGHT, /* Max Width, Height   */
  91.   WBENCHSCREEN,            /* Type */
  92. };
  93.  
  94. #define emacs_icon_width 57
  95. #define emacs_icon_height 55
  96. #define emacs_icon_num_planes 1
  97. #define emacs_icon_words_per_plane 220
  98.  
  99. UWORD chip emacs_icon_data[1][55][4] = {
  100.   {
  101.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  102.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  103.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0fe0,0x6000,
  104.     0x0000,0x0000,0x0060,0x6000,0x0000,0x0000,0x0fff,0xe000,
  105.     0x0000,0x0000,0x1800,0x2000,0x0000,0x0000,0x13ff,0xa000,
  106.     0x0000,0x0000,0x1400,0xa000,0x0000,0x0000,0x3600,0xa000,
  107.     0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x0c00,0xa000,
  108.     0x0000,0x0000,0x1e00,0xa000,0x0000,0x0000,0x0c00,0xa000,
  109.     0x0000,0x0000,0x0000,0xa000,0x0000,0x0000,0x2100,0xa000,
  110.     0x0000,0x0000,0x3300,0xa000,0x0000,0x0000,0x0c00,0xa000,
  111.     0x003f,0xffff,0xffff,0xb000,0x001f,0xffff,0xffff,0x8000,
  112.     0x004e,0x0000,0x0001,0xf000,0x00c6,0x00f0,0x0001,0x8000,
  113.     0x00c6,0x0100,0x0001,0x8000,0x0006,0x0103,0x9201,0x8000,
  114.     0x0006,0x013a,0x5201,0x8000,0x00c6,0x010a,0x5201,0x8000,
  115.     0x00c6,0x010a,0x5601,0x8000,0x0086,0x00f2,0x4a01,0x8000,
  116.     0x0006,0x0000,0x0001,0x8000,0x0046,0x0000,0x0001,0x8000,
  117.     0x00c6,0x7c00,0x0001,0x8000,0x00c6,0x4000,0x0001,0x8000,
  118.     0x0006,0x41d8,0xc319,0x8000,0x0006,0x7925,0x24a1,0x8000,
  119.     0x00c6,0x4125,0x2419,0x8000,0x01c6,0x4125,0x2485,0x8000,
  120.     0x0086,0x7d24,0xd319,0x8000,0x0007,0x0000,0x0003,0x8000,
  121.     0x0003,0xffe3,0xffff,0x0000,0x0081,0xfff7,0xfffe,0x0000,
  122.     0x01c0,0x0036,0x0000,0x0000,0x0180,0x0014,0x0f80,0x0000,
  123.     0x0000,0x0014,0x1040,0x0000,0x0000,0x0014,0x2720,0x0000,
  124.     0x0000,0x0012,0x28a0,0x0000,0x0080,0x000a,0x48a0,0x0000,
  125.     0x01c0,0x0009,0x90a0,0x0000,0x0180,0x0004,0x20a0,0x0000,
  126.     0x0000,0x0003,0xc0a0,0x0000,0x0000,0x0000,0x00a0,0x0000,
  127.     0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,0x0000,
  128.     0x0000,0x0000,0x0000,0x0000
  129.   },
  130. };
  131.  
  132. struct Image far emacs_icon_image = {
  133.   0, 0,
  134.   emacs_icon_width, emacs_icon_height, emacs_icon_num_planes,
  135.   (UWORD *)emacs_icon_data,
  136.   3, 0,
  137.   0
  138. };
  139.  
  140. static struct DiskObject far emacs_icon_object = {
  141.   0, 0,
  142.   { 0, 0, 0, emacs_icon_width, emacs_icon_height, 0, 0, 0, (APTR)&emacs_icon_image },
  143.   0, 0, 0,
  144.   NO_ICON_POSITION, NO_ICON_POSITION
  145. };
  146.  
  147. static struct Hook background_hook;
  148.  
  149. #define EVENTSIZE 32
  150.  
  151. static struct event {
  152.   ULONG class;
  153.   UWORD code, qual;
  154.   WORD x, y;
  155. } events[EVENTSIZE];
  156. static int event_num, event_in, event_out;
  157.  
  158. static struct wbevent {
  159.   struct wbevent *next;
  160.   char file[1];
  161. } *wbevents;
  162.  
  163. Lisp_Object Vamiga_mouse_pos;
  164. Lisp_Object Vamiga_mouse_item;
  165. extern Lisp_Object MouseMap;
  166. int amiga_remap_bsdel;
  167. int amiga_mouse_initialized;
  168. int amiga_wb_initialized;
  169. int emacs_iconified;
  170.  
  171. static int amiga_pos_x(int x)
  172. {
  173.   return (x - emacs_win->BorderLeft) / emacs_win->RPort->Font->tf_XSize;
  174. }
  175.  
  176. static int amiga_pos_y(int y)
  177. {
  178.   return (y - emacs_win->BorderTop) / emacs_win->RPort->Font->tf_YSize;
  179. }
  180.  
  181. static void amiga_change_size(void)
  182. {
  183.   int new_height = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  184.   int new_width = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  185.  
  186.   /* Hack to force redisplay */
  187.   if (screen_height == new_height) screen_height--;
  188.   /* I consider that refreshes are possible during a select, which is
  189.      true for the current state of emacs */
  190.   change_screen_size(new_height, new_width, 0, !selecting && !waiting_for_input, 1);
  191. }
  192.  
  193. /* Get terminal size from system.
  194.    Store number of lines into *heightp and width into *widthp.
  195.    If zero or a negative number is stored, the value is not valid.  */
  196.  
  197. void get_window_size (widthp, heightp)
  198.      int *widthp, *heightp;
  199. {
  200.   if (emacs_win)
  201.     {
  202.       *heightp = amiga_pos_y(emacs_win->Height - emacs_win->BorderBottom);
  203.       *widthp = amiga_pos_x(emacs_win->Width - emacs_win->BorderRight);
  204.     }
  205.   else
  206.     {
  207.       *heightp = 0;
  208.       *widthp = 0;
  209.     }
  210. }
  211.  
  212. static int set_min_size(struct Window *win, struct TextFont *font,
  213.             WORD *minw, WORD *minh)
  214. {
  215.   *minw = 11 * font->tf_XSize + win->BorderLeft + win->BorderRight;
  216.   *minh = 4 * font->tf_YSize + win->BorderTop + win->BorderBottom;
  217.  
  218.   return (int)WindowLimits(emacs_win, *minw, *minh, 0, 0);
  219. }
  220.  
  221. struct fill
  222. {
  223.   struct Layer *layer;
  224.   struct Rectangle bounds;
  225.   WORD offsetx, offsety;
  226. };
  227.  
  228. static ULONG __asm __saveds fill_background(register __a2 struct RastPort *obj,
  229.                                             register __a1 struct fill *msg)
  230. {
  231.   struct Layer *l;
  232.  
  233.   SetAPen(obj, background);
  234.   SetDrMd(obj, JAM1);
  235.   SetAfPt(obj, 0, 0);
  236.   SetWrMsk(obj, 0xff);
  237.   /* Gross hack starts here */
  238.   l = obj->Layer;
  239.   obj->Layer = 0;
  240.   /* Stops */
  241.   RectFill(obj, msg->bounds.MinX, msg->bounds.MinY,
  242.        msg->bounds.MaxX, msg->bounds.MaxY);
  243.   /* Starts again */
  244.   obj->Layer = l;
  245.   /* And finally dies */
  246.  
  247.   return 0;
  248. }
  249.  
  250. static void clear_window(void)
  251. {
  252.   SetAPen(emacs_win->RPort, background);
  253.   RectFill(emacs_win->RPort, emacs_win->BorderLeft, emacs_win->BorderTop,
  254.        emacs_win->Width - emacs_win->BorderRight - 1,
  255.        emacs_win->Height - emacs_win->BorderBottom - 1);
  256. }
  257.  
  258. static int make_reset_string(void)
  259. {
  260.   sprintf(reset_string, CONSOLE_RESET, foreground, background, background);
  261. }
  262.  
  263. void reset_window(void)
  264. {
  265.   make_reset_string();
  266.   if (emacs_win)
  267.     {
  268.       screen_puts (reset_string, strlen(reset_string));
  269.       clear_window();
  270.       amiga_change_size ();
  271.     }
  272. }
  273.  
  274. static void close_app_win(void)
  275. {
  276.   if (emacs_app_win)
  277.     {
  278.       struct AppMessage *msg;
  279.  
  280.       RemoveAppWindow(emacs_app_win); /* What can I do if it fails ?! */
  281.       while (msg = (struct AppMessage *)GetMsg(wbport)) ReplyMsg(msg);
  282.     }
  283. }
  284.  
  285. static int close_emacs_window(void)
  286. {
  287.   close_app_win();
  288.   inputsig &= ~(1L << emacs_win->UserPort->mp_SigBit);
  289.   _device_close(emacs_console);
  290.   CloseWindow(emacs_win);
  291.   emacs_console = 0;
  292.   emacs_win = 0;
  293.   ConsoleDevice = 0;
  294. }
  295.  
  296. static enum { ok, no_screen, no_window }
  297. open_emacs_window(UWORD x, UWORD y, UWORD w, UWORD h)
  298.      /* Open or reopen emacs window */
  299. {
  300.   WORD minw, minh;
  301.   struct Screen *emacs_screen;
  302.  
  303.   emacs_screen = LockPubScreen(emacs_screen_name);
  304.   if (!emacs_screen) return no_screen;
  305.   emacs_win = OpenWindowTags(&emacs_window,
  306.                  WA_Left, x, WA_Top, y, WA_Width, w, WA_Height, h,
  307.                  WA_PubScreen, emacs_screen,
  308.                  WA_BackFill, &background_hook,
  309.                  WA_MenuHelp, TRUE,
  310.                  TAG_END);
  311.   UnlockPubScreen(0L, emacs_screen);
  312.   if (emacs_win)
  313.     {
  314.       SetFont(emacs_win->RPort, font);
  315.  
  316.       if (set_min_size(emacs_win, font, &minw, &minh) &&
  317.       (emacs_console = (struct IOStdReq *)
  318.        _device_open("console.device", CONU_CHARMAP, CONFLAG_NODRAW_ON_NEWSIZE,
  319.             (APTR)emacs_win, sizeof(*emacs_win),
  320.             sizeof(struct IOStdReq))))
  321.     {
  322.       inputsig |= 1L << emacs_win->UserPort->mp_SigBit;
  323.       ConsoleDevice = emacs_console->io_Device;
  324.       emacs_app_win = AddAppWindowA(0, 0, emacs_win, wbport, 0);
  325.       reset_window();
  326.       return ok;
  327.     }
  328.       CloseWindow(emacs_win);
  329.     }
  330.   emacs_win = 0;
  331.   emacs_console = 0;
  332.   return no_window;
  333. }
  334.  
  335. void force_window(void)
  336. {
  337.   if (!emacs_win && !emacs_iconified)
  338.     {
  339.       if (open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h) != ok)
  340.     {
  341.       /* Try to return to Workbench */
  342.       if (emacs_screen_name) free(emacs_screen_name);
  343.       emacs_screen_name = 0;
  344.       if (open_emacs_window(0, 0, 640, 200) != ok)
  345.           _fail("I've lost my window ! Exiting.");
  346.     }
  347.       resume_menus();
  348.     }
  349. }
  350.  
  351. /* returns:
  352.  *    -2 if msg is not class RAWKEY
  353.  *    same as RawKeyConvert otherwise:
  354.  *    buffer length if <= kbsize
  355.  *    -1 else
  356.  */
  357. static DeadKeyConvert(struct IntuiMessage *msg, UBYTE *kbuffer, int kbsize,
  358.               struct KeyMap *kmap)
  359. {
  360.   static struct InputEvent ievent = {0, IECLASS_RAWKEY, 0, 0, 0};
  361.   int extra = 0, res;
  362.  
  363.   if (msg->Class != RAWKEY) return (-2);
  364.  
  365.   /* Do some keymapping ourselves to make emacs users happy */
  366.  
  367.   /* Ctrl-space becomes Ctrl-@ */
  368.   if (msg->Code == 0x40 && msg->Qualifier & CONTROL_MASK)
  369.     {
  370.       *kbuffer = 0;
  371.       return 1;
  372.     }
  373.   /* Backspace becomes DEL */
  374.   if (msg->Code == 0x41 && amiga_remap_bsdel)
  375.     {
  376.       *kbuffer = 0177;
  377.       return 1;
  378.     }
  379.   /* And DEL becomes CTRL-D */
  380.   if (msg->Code == 0x46 && amiga_remap_bsdel)
  381.     {
  382.       *kbuffer = 04;
  383.       return 1;
  384.     }
  385.   /* Stick numeric pad prefix in front of numeric keypad chars */
  386.   if (msg->Qualifier & IEQUALIFIER_NUMERICPAD)
  387.     {
  388.       *kbuffer++ = 'x' & 037;
  389.       *kbuffer++ = '^' & 037;
  390.       *kbuffer++ = 'K';
  391.       kbsize -= 3;
  392.       extra = 3;
  393.     }
  394.  
  395.   /* pack input event */
  396.   ievent.ie_Code = msg->Code;
  397.  
  398.   /* Ignore meta in decoding keys */
  399.   ievent.ie_Qualifier = msg->Qualifier & ~META_MASK;
  400.  
  401.   /* get previous codes from location pointed to by IAddress
  402.    *  this pointer is valid until IntuiMessage is replied.
  403.    */
  404.   ievent.ie_position.ie_addr = *((APTR *)msg->IAddress);
  405.   ievent.ie_position.ie_dead.ie_prev1DownQual &= ~META_MASK;
  406.   ievent.ie_position.ie_dead.ie_prev2DownQual &= ~META_MASK;
  407.  
  408.   res = RawKeyConvert(&ievent, kbuffer, kbsize, kmap);
  409.   return res ? res + extra : 0;
  410. }
  411.  
  412. void add_wbevent(struct WBArg *wbarg)
  413. {
  414.   char filename[256];
  415.  
  416.   if (NameFromLock(wbarg->wa_Lock, filename, 256))
  417.     {
  418.       struct wbevent *event;
  419.       AddPart(filename, wbarg->wa_Name, 256);
  420.       if (event = (struct wbevent *)malloc(offsetof(struct wbevent, file) +
  421.                        strlen(filename) + 1))
  422.     {
  423.       event->next = wbevents;
  424.       strcpy(event->file, filename);
  425.       wbevents = event;
  426.     }
  427.     }
  428. }
  429.  
  430. void check_window(int force)
  431. {
  432.   ULONG class;
  433.   USHORT code, qualifier;
  434.   UWORD mx, my;
  435.   unsigned char buf[32];
  436.   int buflen, deiconify, i;
  437.   struct IntuiMessage *msg;
  438.   int mouse_event = FALSE, wb_event = FALSE;
  439.   struct AppMessage *amsg;
  440.  
  441.   force_window();
  442.  
  443.   if (emacs_win)
  444.     while (msg = (struct IntuiMessage *)GetMsg(emacs_win->UserPort))
  445.       {
  446.     class = msg->Class;
  447.     code = msg->Code;
  448.     qualifier = msg->Qualifier;
  449.     mx = msg->MouseX; my = msg->MouseY;
  450.     buflen = DeadKeyConvert(msg, buf, 32, 0);
  451.     ReplyMsg(msg);
  452.  
  453.     switch (class)
  454.       {
  455.       case IDCMP_CLOSEWINDOW: {
  456.         enque(030, FALSE); enque(03, FALSE); /* ^X^C */
  457.         break;
  458.       }
  459.       case IDCMP_RAWKEY: {
  460.         if (buflen > 0)
  461.           {
  462.         unsigned char *sbuf = buf;
  463.         int meta = qualifier & META_MASK;
  464.  
  465.         /* Don't set META on CSI */
  466.         do enque(*sbuf++, meta); while (--buflen);
  467.           }
  468.         break;
  469.       }
  470.       case IDCMP_NEWSIZE: amiga_change_size(); break;
  471.       case IDCMP_MENUPICK: case IDCMP_MENUHELP:
  472.         if (code == MENUNULL) break; /* else fall through */
  473.       case IDCMP_MOUSEBUTTONS: {
  474.         mouse_event = TRUE;
  475.         if (event_num == EVENTSIZE) break;
  476.  
  477.         events[event_in].class = class;
  478.         events[event_in].code = code;
  479.         events[event_in].qual = qualifier;
  480.         events[event_in].x = mx;
  481.         events[event_in].y = my;
  482.         event_num++;
  483.         event_in = (event_in + 1) % EVENTSIZE;
  484.  
  485.         break;
  486.       }
  487.       }
  488.       }
  489.   /* Handle App requests */
  490.   while (amsg = (struct AppMessage *)GetMsg(wbport))
  491.       switch (amsg->am_Type)
  492.     {
  493.     case MTYPE_APPICON: case MTYPE_APPWINDOW: 
  494.       /* Add an event for all these files */
  495.       for (i = 0; i < amsg->am_NumArgs; i++) add_wbevent(amsg->am_ArgList + i);
  496.       wb_event = TRUE;
  497.       /* Reply to the message, and deiconify if was icon */
  498.       deiconify = amsg->am_Type == MTYPE_APPICON;
  499.       ReplyMsg(amsg);
  500.       if (deiconify && emacs_icon)
  501.         {
  502.           RemoveAppIcon(emacs_icon);
  503.           emacs_icon = 0;
  504.           emacs_iconified = 0;
  505.           /* Reopen window */
  506.           if (open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h) == ok)
  507.           resume_menus();
  508.           else
  509.         _fail("Failed to reinitialise after iconification (No memory?)");
  510.         }
  511.       break;
  512.     default: ReplyMsg(amsg); break;
  513.     }
  514.  
  515.   if (amiga_mouse_initialized && (force && event_num > 0 || mouse_event))
  516.     {
  517.       enque(AMIGASEQ, FALSE); enque('M', FALSE);
  518.     }
  519.   if (amiga_wb_initialized && (force && wbevents || wb_event))
  520.     {
  521.       enque(AMIGASEQ, FALSE); enque('W', FALSE);
  522.     }
  523. }
  524.  
  525. void setup_intchar(char intchar)
  526. {
  527.   char cqbuf[2];
  528.  
  529.   if (MapANSI(&intchar, 1, cqbuf, 1, 0) == 1)
  530.     {
  531.       intkey_code = cqbuf[0];
  532.       intkey_qualifier = cqbuf[1];
  533.     }
  534.   else
  535.     {
  536.       /* Default is CTRL-G in usa0 keymap */
  537.       intkey_code = 0x24;
  538.       intkey_qualifier = IEQUALIFIER_CONTROL;
  539.     }
  540. }
  541.  
  542. /* Hack to detect interrupt char as soon as it is pressed */
  543. static long __saveds __asm int_handler(register __a0 struct InputEvent *ev)
  544. {
  545.   struct InputEvent *ep, *laste;
  546.   static struct InputEvent retkey;
  547.   ULONG lock = LockIBase(0);
  548.  
  549.   if (emacs_win && IntuitionBase->ActiveWindow == emacs_win)
  550.     /* run down the list of events to see if they pressed the magic key */
  551.     for (ep = ev; ep; ep = ep->ie_NextEvent)
  552.     if (ep->ie_Class == IECLASS_RAWKEY &&
  553.         (ep->ie_Qualifier & 0xff) == intkey_qualifier &&
  554.         ep->ie_Code == intkey_code)
  555.       {
  556.         Vquit_flag = Qt;
  557.         Signal(_us, SIGBREAKF_CTRL_C);
  558.       }
  559.   UnlockIBase(lock);
  560.  
  561.   /* pass on the pointer to the event */
  562.   return (long)ev;
  563. }
  564.  
  565. DEFUN ("amiga-mouse-events", Famiga_mouse_events, Samiga_mouse_events, 0, 0, 0,
  566.        "Return number of pending mouse events from Intuition.")
  567.      ()
  568. {
  569.   register Lisp_Object tem;
  570.  
  571.   check_intuition ();
  572.  
  573.   XSET (tem, Lisp_Int, event_num);
  574.  
  575.   return tem;
  576. }
  577.  
  578. DEFUN ("amiga-proc-mouse-event", Famiga_proc_mouse_event, Samiga_proc_mouse_event,
  579.        0, 0, 0,
  580.        "Pulls a mouse event out of the mouse event buffer and dispatches\n\
  581. the appropriate function to act upon this event.")
  582. ()
  583. {
  584.   register Lisp_Object mouse_cmd;
  585.   register char com_letter;
  586.   register char key_mask;
  587.   register Lisp_Object tempx;
  588.   register Lisp_Object tempy;
  589.   extern Lisp_Object get_keyelt ();
  590.   extern int meta_prefix_char;
  591.   struct event *ev;
  592.  
  593.   check_intuition ();
  594.  
  595.   if (event_num) {
  596.     ev = &events[event_out];
  597.     event_out = (event_out + 1) % EVENTSIZE;
  598.     event_num--;
  599.     if (ev->class == MOUSEBUTTONS)
  600.       {
  601.     switch (ev->code)
  602.       {
  603.       case SELECTDOWN: com_letter = 2; break;
  604.       case SELECTUP: com_letter = 6; break;
  605.       case MIDDLEDOWN: com_letter = 1; break;
  606.       case MIDDLEUP: com_letter = 5; break;
  607.       case MENUDOWN: com_letter = 0; break;
  608.       case MENUUP: com_letter = 4; break;
  609.       default: com_letter = 3; break;
  610.       }
  611.     XSET (tempx, Lisp_Int,
  612.           min (screen_width-1,
  613.            max (0, amiga_pos_x(ev->x))));
  614.     XSET (tempy, Lisp_Int,
  615.           min (screen_height-1,
  616.            max (0, amiga_pos_y(ev->y))));
  617.       }
  618.     else
  619.       {
  620.     /* Must be Menu Pick or Help */
  621.     com_letter = ev->class == IDCMP_MENUPICK ? 3 : 7;
  622.  
  623.     /* The parameters passed describe the selected item */
  624.     XSET (tempx, Lisp_Int, MENUNUM(ev->code));
  625.     XSET (tempy, Lisp_Int, ITEMNUM(ev->code));
  626.       }
  627.     if (ev->qual & META_MASK) com_letter |= 0x20;
  628.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  629.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  630.  
  631.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  632.     Vamiga_mouse_item = make_number (com_letter);
  633.     mouse_cmd = get_keyelt (access_keymap (MouseMap, com_letter));
  634.     if (NULL (mouse_cmd)) {
  635.       bell ();
  636.       Vamiga_mouse_pos = Qnil;
  637.     }
  638.     else return call1 (mouse_cmd, Vamiga_mouse_pos);
  639.   }
  640.   return Qnil;
  641. }
  642.  
  643. DEFUN ("amiga-get-mouse-event", Famiga_get_mouse_event, Samiga_get_mouse_event,
  644.        1, 1, 0,
  645.        "Get next mouse event out of mouse event buffer (com-letter (x y)).\n\
  646. ARG non-nil means return nil immediately if no pending event;\n\
  647. otherwise, wait for an event.")
  648. (arg)
  649. Lisp_Object arg;
  650. {
  651.   register char com_letter;
  652.   register char key_mask;
  653.  
  654.   register Lisp_Object tempx;
  655.   register Lisp_Object tempy;
  656.   struct event *ev;
  657.  
  658.   check_intuition ();
  659.  
  660.   if (NULL (arg))
  661.     {
  662.       amiga_consume_input();
  663.       while (!event_num)
  664.     {
  665.       int rfds = 1;
  666.  
  667.       select(1, &rfds, 0, 0, 0);
  668.       amiga_consume_input();
  669.     }
  670.     }
  671.   /*** ??? Surely you don't mean to busy wait??? */
  672.  
  673.   if (event_num) {
  674.     ev = &events[event_out];
  675.     event_out = (event_out + 1) % EVENTSIZE;
  676.     event_num--;
  677.     switch (ev->code)
  678.       {
  679.       case SELECTDOWN: com_letter = 2; break;
  680.       case SELECTUP: com_letter = 6; break;
  681.       case MIDDLEDOWN: com_letter = 1; break;
  682.       case MIDDLEUP: com_letter = 5; break;
  683.       case MENUDOWN: com_letter = 0; break;
  684.       case MENUUP: com_letter = 4; break;
  685.       default: com_letter = 3; break;
  686.       }
  687.     if (ev->qual & META_MASK) com_letter |= 0x20;
  688.     if (ev->qual & SHIFT_MASK) com_letter |= 0x10;
  689.     if (ev->qual & CONTROL_MASK) com_letter |= 0x40;
  690.  
  691.     XSET (tempx, Lisp_Int,
  692.       min (screen_width-1,
  693.            max (0, amiga_pos_x(ev->x))));
  694.     XSET (tempy, Lisp_Int,
  695.       min (screen_height-1,
  696.            max (0, amiga_pos_y(ev->y))));
  697.  
  698.     Vamiga_mouse_pos = Fcons (tempx, Fcons (tempy, Qnil));
  699.     Vamiga_mouse_item = make_number (com_letter);
  700.     return Fcons (com_letter, Fcons (Vamiga_mouse_pos, Qnil));
  701.   }
  702.   return Qnil;
  703. }
  704.  
  705. DEFUN ("amiga-get-wb-event", Famiga_get_wb_event, Samiga_get_wb_event,
  706.        1, 1, 0,
  707.        "Get next Workbench event out of workbench event buffer (a file name).\n\
  708. ARG non-nil means return nil immediately if no pending event;\n\
  709. otherwise, wait for an event.")
  710. (arg)
  711. Lisp_Object arg;
  712. {
  713.   Lisp_Object file;
  714.   struct wbevent *ev;
  715.  
  716.   check_intuition ();
  717.  
  718.   if (NULL (arg))
  719.     {
  720.       amiga_consume_input();
  721.       while (!wbevents)
  722.     {
  723.       int rfds = 1;
  724.  
  725.       select(1, &rfds, 0, 0, 0);
  726.       amiga_consume_input();
  727.     }
  728.     }
  729.   /*** ??? Surely you don't mean to busy wait??? */
  730.  
  731.   if (wbevents) {
  732.     file = build_string(wbevents->file);
  733.     ev = wbevents;
  734.     wbevents = wbevents->next;
  735.     free(ev);
  736.     return file;
  737.   }
  738.   return Qnil;
  739. }
  740.  
  741. DEFUN("amiga-set-foreground-color", Famiga_set_foreground_color,
  742.       Samiga_set_foreground_color, 1, 1, "nPen number: ",
  743.       "Use PEN as foreground color")
  744.      (pen)
  745. {
  746.   int fg;
  747.  
  748.   check_intuition();
  749.   CHECK_NUMBER(pen, 0);
  750.  
  751.   fg = XUINT (pen);
  752.   if (pen > 7) error("Pen colors must be between 0 & 7");
  753.   foreground = fg;
  754.   reset_window();
  755.   return Qnil;
  756. }
  757.  
  758. DEFUN("amiga-set-background-color", Famiga_set_background_color,
  759.       Samiga_set_background_color, 1, 1, "nPen number: ",
  760.       "Use PEN as background color")
  761.      (pen)
  762. {
  763.   int bg;
  764.  
  765.   check_intuition();
  766.   CHECK_NUMBER(pen, 0);
  767.  
  768.   bg = XUINT (pen);
  769.   if (pen > 7) error("Pen colors must be between 0 & 7");
  770.   background = bg;
  771.   reset_window();
  772.   return Qnil;
  773. }
  774.  
  775. DEFUN("amiga-set-font", Famiga_set_font, Samiga_set_font, 2, 2,
  776.       "sFont: \n\
  777. nSize: ",
  778.       "Set font used for window to FONT with given HEIGHT.\n\
  779. The font used must be non-proportional.")
  780. (wfont, height)
  781. {
  782.   struct TextAttr attr;
  783.   struct TextFont *newfont;
  784.   char *fname;
  785.   struct Lisp_String *fstr;
  786.   WORD minw, minh, oldmw, oldmh;
  787.  
  788.   CHECK_STRING (wfont, 0);
  789.   CHECK_NUMBER (height, 0);
  790.  
  791.   check_intuition();
  792.  
  793.   fstr = XSTRING (wfont);
  794.   fname = (char *)alloca (fstr->size + 6);
  795.   strcpy (fname, fstr->data);
  796.   strcat (fname, ".font");
  797.   attr.ta_Name = fname;
  798.   attr.ta_YSize = XFASTINT (height);
  799.   attr.ta_Style = 0;
  800.   attr.ta_Flags = 0;
  801.   newfont = OpenDiskFont (&attr);
  802.  
  803.   if (!newfont)
  804.     error ("Font %s %d not found", fstr->data, XFASTINT (height));
  805.   if (newfont->tf_Flags & FPF_PROPORTIONAL)
  806.     {
  807.       CloseFont(newfont);
  808.       error ("Font %s %d is proportional", fstr->data, XFASTINT (height));
  809.     }
  810.  
  811.   if (emacs_win)
  812.     {
  813.       if (!set_min_size(emacs_win, newfont, &minw, &minh))
  814.     {
  815.       CloseFont(newfont);
  816.       if (!set_min_size(emacs_win, font, &oldmw, &oldmh))
  817.         _fail("Failed to restore old font, exiting.");
  818.       error("Window is too small for this font, need at least %d(w) by %d(h)",
  819.         minw, minh);
  820.     }
  821.       SetFont(emacs_win->RPort, newfont);
  822.     }
  823.   if (font_opened) CloseFont(font);
  824.   font_opened = TRUE;
  825.   font = newfont;
  826.   reset_window();
  827.   return Qnil;
  828. }
  829.  
  830. DEFUN("amiga-set-geometry", Famiga_set_geometry, Samiga_set_geometry, 4, 5, 0,
  831.       "Set Emacs window geometry and screen.\n\
  832. First 4 parameters are the (X,Y) position of the top-left corner of the window\n\
  833. and its WIDTH and HEIGHT. These must be big enough for an 11x4 characters window.\n\
  834. If nil is given for any of these, that means to keep the same value as before.\n\
  835. The optional argument SCREEN specifies which screen to use, nil stands for the\n\
  836. same screen as the window is on, t stands for the default public screen (normally\n\
  837. the Workbench), a string specifies a given public screen.")
  838. (x, y, w, h, scr)
  839. Lisp_Object x, y, w, h, scr;
  840. {
  841.   char *old_name;
  842.   struct Window *old_win;
  843.   struct IOStdReq *old_console;
  844.   int opened;
  845.  
  846.   check_intuition();
  847.  
  848.   if (!NULL (x))
  849.     {
  850.       CHECK_NUMBER(x, 0);
  851.       emacs_x = XUINT(x);
  852.     }
  853.   else if (emacs_win) emacs_x = emacs_win->LeftEdge;
  854.   if (!NULL (y))
  855.     {
  856.       CHECK_NUMBER(y, 0);
  857.       emacs_y = XUINT(y);
  858.     }
  859.   else if (emacs_win) emacs_y = emacs_win->TopEdge;
  860.   if (!NULL (w))
  861.     {
  862.       CHECK_NUMBER(w, 0);
  863.       emacs_w = XUINT(w);
  864.     }
  865.   else if (emacs_win) emacs_w = emacs_win->Width;
  866.   if (!NULL (h))
  867.     {
  868.       CHECK_NUMBER(h, 0);
  869.       emacs_h = XUINT(h);
  870.     }
  871.   else if (emacs_win) emacs_h = emacs_win->Height;
  872.  
  873.   old_name = emacs_screen_name;
  874.   old_win = emacs_win;
  875.   old_console = emacs_console;
  876.  
  877.   if (scr == Qt) emacs_screen_name = 0;
  878.   else if (!NULL (scr))
  879.     {
  880.       CHECK_STRING (scr, 0);
  881.       emacs_screen_name = (char *)xmalloc (XSTRING (scr)->size + 1);
  882.       strcpy(emacs_screen_name, XSTRING (scr)->data);
  883.     }
  884.  
  885.   if (emacs_win)
  886.     {
  887.       suspend_menus();
  888.       opened = open_emacs_window(emacs_x, emacs_y, emacs_w, emacs_h);
  889.       if (opened != ok)
  890.     {
  891.       if (emacs_screen_name && emacs_screen_name != old_name)
  892.         free(emacs_screen_name);
  893.       emacs_screen_name = old_name;
  894.       emacs_win = old_win;
  895.       emacs_console = old_console;
  896.       resume_menus();
  897.  
  898.       if (opened == no_window) error("Failed to open desired window");
  899.       else if (emacs_screen_name)
  900.         error("Unknown public screen %s", XSTRING (scr)->data);
  901.       else error("The default screen wasn't found !?");
  902.     }
  903.  
  904.       if (old_name) free(old_name);
  905.       _device_close(old_console);
  906.       CloseWindow(old_win);
  907.       if (!resume_menus()) error("Failed to recover menus (No memory?)");
  908.     }
  909.   return Qnil;
  910. }
  911.  
  912. DEFUN("amiga-iconify", Famiga_iconify, Samiga_iconify, 0, 0, "",
  913.       "Iconify emacs window. \n\
  914. The routine returns when emacs is deiconified.")
  915. ()
  916. {
  917.   check_intuition();
  918.  
  919.   if (emacs_iconified) error("Already iconified");
  920.  
  921.   if (emacs_icon = AddAppIconA(0, 0, "Emacs", wbport, 0, &emacs_icon_object, 0))
  922.     {
  923.       if (emacs_win)
  924.     {
  925.       /* Close window */
  926.       suspend_menus();
  927.       emacs_x = emacs_win->LeftEdge; emacs_y = emacs_win->TopEdge;
  928.       emacs_w = emacs_win->Width; emacs_h = emacs_win->Height;
  929.       close_emacs_window();
  930.     }
  931.       emacs_iconified = 1;
  932.     }
  933.   else error("Iconify attempt failed\n");
  934. }
  935.  
  936. struct EClockVal scount[16], ecount[16];
  937. long total[16], counting[16], nb[16], susp[16];
  938.  
  939. void start_count(int n)
  940. {
  941.   nb[n]++;
  942.   if (counting[n]) printf("Restarted %d\n", n);
  943.   counting[n] = 1;
  944.   /*ReadEClock(&scount[n]);*/
  945. }
  946.  
  947. void stop_count(int n)
  948. {
  949.   if (counting[n])
  950.     {
  951.       /*ReadEClock(&ecount[n]);*/
  952.       counting[n] = 0;
  953.  
  954.       total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  955.     }
  956. }
  957.  
  958. void suspend_count(int n)
  959. {
  960.   if (counting[n] && susp[n]++ == 0)
  961.     {
  962.       /*ReadEClock(&ecount[n]);*/
  963.       total[n] += ecount[n].ev_lo - scount[n].ev_lo;
  964.     }
  965. }
  966.  
  967. void resume_count(int n)
  968. {
  969.   if (counting[n] && --susp[n] == 0) /*ReadEClock(&scount[n])*/;
  970. }
  971.  
  972. disp_counts(void)
  973. {
  974.   int i;
  975.  
  976.   for (i = 0; i < 16; i++)
  977.     {
  978.       printf("%d(%d) ", total[i], nb[i]);
  979.       total[i] = nb[i] = 0;
  980.     }
  981.   printf("\n");
  982. }
  983.  
  984. void screen_puts(char *str, unsigned int len)
  985. {
  986.   if (emacs_win)
  987.     {
  988.       int i;
  989.  
  990.       emacs_console->io_Command = CMD_WRITE;
  991.       emacs_console->io_Data    = (APTR)str;
  992.       emacs_console->io_Length  = len;
  993.  
  994.       /*    start_count(0);
  995.         for (i = 1; i <= 6; i++) suspend_count(i);*/
  996.       DoIO(emacs_console);
  997.       /*    for (i = 1; i <= 6; i++) resume_count(i);
  998.         stop_count(0);*/
  999.     }
  1000. }
  1001.  
  1002. void syms_of_amiga_screen(void)
  1003. {
  1004.   DEFVAR_LISP ("amiga-mouse-item", &Vamiga_mouse_item,
  1005.            "Encoded representation of last mouse click, corresponding to\n\
  1006. numerical entries in amiga-mouse-map.");
  1007.   Vamiga_mouse_item = Qnil;
  1008.   DEFVAR_LISP ("amiga-mouse-pos", &Vamiga_mouse_pos,
  1009.            "Current x-y position of mouse by row, column as specified by font.");
  1010.   Vamiga_mouse_pos = Qnil;
  1011.  
  1012.   DEFVAR_BOOL ("amiga-remap-bsdel", &amiga_remap_bsdel,
  1013.            "*If true, map DEL to Ctrl-D and Backspace to DEL. \n\
  1014. This is the most convenient (and default) setting. If nil, don't remap.");
  1015.   amiga_remap_bsdel = 1;
  1016.  
  1017.   DEFVAR_BOOL ("amiga-mouse-initialized", &amiga_mouse_initialized,
  1018.            "Set to true once lisp has been setup to process mouse commands.\n\
  1019. No mouse processing request (C-X C-^ M) will be queued while this is nil.");
  1020.   amiga_mouse_initialized = 0;
  1021.  
  1022.   DEFVAR_BOOL ("amiga-wb-initialized", &amiga_wb_initialized,
  1023.            "Set to true once lisp has been setup to process workbench commands.\n\
  1024. No workbench processing request (C-X C-^ W) will be queued while this is nil.");
  1025.   amiga_mouse_initialized = 0;
  1026.  
  1027.   DEFVAR_BOOL ("amiga-emacs-iconified", &emacs_iconified,
  1028.            "True while emacs is iconified.");
  1029.   emacs_iconified = 0;
  1030.  
  1031.   defsubr (&Samiga_mouse_events);
  1032.   defsubr (&Samiga_proc_mouse_event);
  1033.   defsubr (&Samiga_get_mouse_event);
  1034.   defsubr (&Samiga_get_wb_event);
  1035.   defsubr (&Samiga_set_font);
  1036.   defsubr (&Samiga_set_geometry);
  1037.   defsubr (&Samiga_set_background_color);
  1038.   defsubr (&Samiga_set_foreground_color);
  1039.   defsubr (&Samiga_iconify);
  1040. }
  1041.  
  1042. void init_amiga_screen(void)
  1043. {
  1044.   event_num = event_in = event_out = 0;
  1045.  
  1046.   if (!((IntuitionBase = (struct IntuitionBase *)
  1047.      OpenLibrary("intuition.library", 37L)) &&
  1048.     (GfxBase = (struct GfxBase *)OpenLibrary("graphics.library", 0L)) &&
  1049.     (DiskfontBase = (struct DiskfontBase *)OpenLibrary("diskfont.library", 0L)) &&
  1050.     (WorkbenchBase = OpenLibrary("workbench.library", 37)) &&
  1051.     (KeymapBase = OpenLibrary("keymap.library", 36)) &&
  1052.     (input_req = (struct IOStdReq *)_device_open("input.device", 0, 0, 0, 0,
  1053.                              sizeof(struct IOStdReq)))))
  1054.     _fail("Need version 2.04 and diskfont.library!");
  1055.  
  1056.   if (!(wbport = CreateMsgPort())) no_memory();
  1057.  
  1058.   /* Add Ctrl-G detector */
  1059.   int_handler_hook.is_Data = 0;
  1060.   int_handler_hook.is_Code = (void *)int_handler;
  1061.   int_handler_hook.is_Node.ln_Pri = 127;
  1062.   input_req->io_Command = IND_ADDHANDLER;
  1063.   input_req->io_Data = (APTR)&int_handler_hook;
  1064.   DoIO(input_req);
  1065.   hooked = TRUE;
  1066.  
  1067.   inputsig |= 1L << wbport->mp_SigBit; 
  1068.   background_hook.h_Entry = fill_background;
  1069.   emacs_screen_name = 0;
  1070.   font = GfxBase->DefaultFont;
  1071.   emacs_x = 0; emacs_y = 0; emacs_w = 640; emacs_h = 200;
  1072.  
  1073.   init_amiga_menu();
  1074. }
  1075.  
  1076. void cleanup_amiga_screen(void)
  1077. {
  1078.   if (hooked)
  1079.     {
  1080.       input_req->io_Command = IND_REMHANDLER;
  1081.       input_req->io_Data = (APTR)&int_handler_hook;
  1082.       DoIO(input_req);
  1083.     }
  1084.   close_app_win();
  1085.   if (wbport) DeleteMsgPort(wbport);
  1086.   cleanup_amiga_menu();
  1087.   _device_close(emacs_console);
  1088.   if (emacs_win) CloseWindow(emacs_win);
  1089.   if (font_opened) CloseFont(font);
  1090.   if (IntuitionBase) CloseLibrary(IntuitionBase);
  1091.   if (GfxBase) CloseLibrary(GfxBase);
  1092.   if (DiskfontBase) CloseLibrary(DiskfontBase);
  1093.   if (WorkbenchBase) CloseLibrary(WorkbenchBase);
  1094.   if (KeymapBase) CloseLibrary(KeymapBase);
  1095.   _device_close(input_req);
  1096. }
  1097.